unit ALHttpClient;

interface

uses SysUtils, Classes, ALHttpCommon;

type

  {---------------------------------------}
  EALHTTPClientException = class(Exception)
  private
    FStatusCode: Integer;
  public
    constructor Create(const Msg: string; SCode: Integer = 0);
    constructor CreateFmt(const Msg: string; const Args: array of const; SCode: Integer = 0);
    property StatusCode: Integer read FStatusCode write FStatusCode;
  end;

  {-------------------------------------------}
  TALHTTPClientProxyParams = Class(TPersistent)
  Private
    FProxyBypass: String;
    FproxyServer: String;
    FProxyUserName: String;
    FProxyPassword: String;
    FproxyPort: integer;
    FOnChange: TALHTTPPropertyChangeEvent;
    procedure SetProxyBypass(const Value: String);
    procedure SetProxyPassword(const Value: String);
    procedure SetProxyPort(const Value: integer);
    procedure SetProxyServer(const Value: String);
    procedure SetProxyUserName(const Value: String);
    Procedure DoChange(propertyIndex: Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create; virtual;
    procedure Clear;
  published
    Property ProxyBypass: String read FProxyBypass write SetProxyBypass; //index 0
    property ProxyServer: String read FProxyServer write SetProxyServer; //index 1
    property ProxyPort: integer read FProxyPort write SetProxyPort default 0; //index 2
    property ProxyUserName: String read FProxyUserName write SetProxyUserName; //index 3
    property ProxyPassword: String read FProxyPassword write SetProxyPassword; //index 4
    property OnChange: TALHTTPPropertyChangeEvent read FOnChange write FOnChange;
  end;

  {----------------------------------------------------------------------------------------------}
  TAlHTTPClientRedirectEvent         = procedure(sender: Tobject; const NewURL: String) of object;
  TALHTTPClientUploadProgressEvent   = procedure(sender: Tobject; Sent: Integer; Total: Integer) of object;
  TALHTTPClientDownloadProgressEvent = procedure(sender: Tobject; Read: Integer; Total: Integer) of object;

  {-------------------------------}
  TALHTTPClient = class(TComponent)
  private
    FProxyParams: TALHTTPClientProxyParams;
    FRequestHeader: TALHTTPRequestHeader;
    FProtocolVersion: TALHTTPProtocolVersion;
    FRequestMethod: TALHTTPRequestMethod;
    FURL: string;
    FUserName: string;
    FPassword: string;
    FConnectTimeout: Integer;
    FSendTimeout: Integer;
    FReceiveTimeout: Integer;
    FOnUploadProgress: TALHTTPClientUploadProgressEvent;
    FOnDownloadProgress: TALHTTPClientDownloadProgressEvent;
    FOnRedirect: TAlHTTPClientRedirectEvent;
    FUploadBufferSize: Integer;
  protected
    procedure SetURL(const Value: string); virtual;
    procedure SetUsername(const NameValue: string); virtual;
    procedure SetPassword(const PasswordValue: string); virtual;
    procedure OnProxyParamsChange(sender: Tobject; Const PropertyIndex: Integer); virtual;
    procedure OnRequestHeaderChange(sender: Tobject; Const PropertyIndex: Integer); virtual;
    procedure SetUploadBufferSize(const Value: Integer); virtual;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Execute(const aRequestDataStream: TStream; aResponseContentStream: TStream; aResponseContentHeader: TALHTTPResponseHeader); virtual;
    Procedure Get(aUrl:String; aResponseContentStream: TStream; aResponseContentHeader: TALHTTPResponseHeader); overload;
    Function  Get(aUrl:String): String; overload;
  published
    property  URL: string read FURL write SetURL;
    property  ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout default 0;
    property  SendTimeout: Integer read FSendTimeout write FSendTimeout default 0;
    property  ReceiveTimeout: Integer read FReceiveTimeout write FReceiveTimeout default 0;
    property  UploadBufferSize: Integer read FUploadBufferSize write SetUploadBufferSize default $8000;
    property  ProxyParams: TALHTTPClientProxyParams read FProxyParams;
    property  RequestHeader: TALHTTPRequestHeader read FRequestHeader;
    Property  ProtocolVersion: TALHTTPProtocolVersion read FProtocolVersion write FProtocolVersion default HTTPpv_1_1;
    Property  RequestMethod: TALHTTPRequestMethod read FRequestMethod write fRequestMethod default HTTPrm_get;
    property  UserName: string read FUserName write SetUserName;
    property  Password: string read FPassword write SetPassword;
    property  OnUploadProgress: TALHTTPClientUploadProgressEvent read FOnUploadProgress write FOnUploadProgress;
    property  OnDownloadProgress: TALHTTPClientDownloadProgressEvent read FonDownloadProgress write FonDownloadProgress;
    property  OnRedirect: TAlHTTPClientRedirectEvent read FOnRedirect write FOnRedirect;
  end;

 ResourceString

  CALHTTPCLient_MsgInvalidURL         = 'Invalid url ''%s'' - only supports ''http'' and ''https'' schemes';
  CALHTTPCLient_MsgInvalidHTTPRequest = 'Invalid HTTP Request: Length is 0';
  CALHTTPCLient_MsgEmptyURL           = 'Empty URL';

 implementation

////////////////////////////////////////////////////////////////////////////////
////////// EALHTTPClientException //////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

{*******************************************************************************}
constructor EALHTTPClientException.Create(const Msg: string; SCode: Integer = 0);
begin
  inherited Create(Msg);
  FStatusCode := SCode;
end;

{**************************************************************************************************************}
constructor EALHTTPClientException.CreateFmt(const Msg: string; const Args: array of const; SCode: Integer = 0);
begin
  inherited CreateFmt(Msg, Args);
  FStatusCode := SCode;
end;

////////////////////////////////////////////////////////////////////////////////
////////// TALWinInetHTTPClient ////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

{**************************************************}
constructor TALHTTPClient.Create(Owner: TComponent);
begin
  inherited;
  FUploadBufferSize := $8000;
  FConnectTimeout := 0;
  FSendTimeout := 0;
  FReceiveTimeout := 0;
  FURL:= '';
  FUserName := '';
  FPassword := '';
  FOnUploadProgress := nil;
  FOnDownloadProgress := nil;
  FOnRedirect := nil;
  FProxyParams := TALHTTPClientProxyParams.Create;
  FRequestHeader := TALHTTPRequestHeader.Create(self);
  FRequestHeader.UserAgent := 'Mozilla/3.0 (compatible; TALHTTPClient)';
  FProtocolVersion := HTTPpv_1_1;
  FRequestMethod := HTTPrm_get;
  FrequestHeader.OnChange := OnRequestHeaderChange;
  FProxyParams.OnChange := OnProxyParamsChange;
end;

{*******************************}
destructor TALHTTPClient.Destroy;
begin
  FProxyParams.free;
  FRequestHeader.free;
  inherited;
end;

{**************************************************}
procedure TALHTTPClient.SetURL(const Value: string);
begin
  Furl := Value;
end;

{***********************************************************}
procedure TALHTTPClient.SetUsername(const NameValue: string);
begin
  FUserName := NameValue;
end;

{***************************************************************}
procedure TALHTTPClient.SetPassword(const PasswordValue: string);
begin
  FPassword := PasswordValue;
end;

{****************************************************************}
procedure TALHTTPClient.Execute(const aRequestDataStream: TStream;
                                aResponseContentStream: TStream;
                                aResponseContentHeader: TALHTTPResponseHeader);
begin
// virtual;
end;

{***************************************}
procedure TALHTTPClient.Get(aUrl: String;
                            aResponseContentStream: TStream;
                            aResponseContentHeader: TALHTTPResponseHeader);
begin
  Url := aURL;
  RequestMethod := HTTPrm_get;
  Execute(
          nil,
          aResponseContentStream,
          aResponseContentHeader
         );
end;

{***********************************************}
function TALHTTPClient.Get(aUrl: String): String;
var aResponseContentStream: TStringStream;
begin
  aResponseContentStream := TstringStream.Create('');
  try
    Get(
        aUrl,
        aResponseContentStream,
        nil
       );
    result := aResponseContentStream.DataString;
  finally
    aResponseContentStream.Free;
  end;
end;

{*****************************************************************************************}
procedure TALHTTPClient.OnProxyParamsChange(sender: Tobject; Const PropertyIndex: Integer);
begin
 //virtual
end;

{*******************************************************************************************}
procedure TALHTTPClient.OnRequestHeaderChange(sender: Tobject; Const PropertyIndex: Integer);
begin
 //virtual
end;

{****************************************************************}
procedure TALHTTPClient.SetUploadBufferSize(const Value: Integer);
begin
  If Value >= 0 then FUploadBufferSize := Value;
end;

///////////////////////////////////////////////////////////////////////////////////////
////////// TALHTTPClientProxyParams ///////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////

{*************************************************************}
procedure TALHTTPClientProxyParams.AssignTo(Dest: TPersistent);
begin
  if Dest is TALHTTPClientProxyParams then begin
    with Dest as TALHTTPClientProxyParams do begin
      FProxyBypass := self.FProxyBypass;
      FproxyServer := self.FproxyServer;
      FProxyUserName := self.FProxyUserName;
      FProxyPassword := self.FProxyPassword;
      FproxyPort := self.FproxyPort;
    end;
  end
  else inherited AssignTo(Dest);
end;

{***************************************}
procedure TALHTTPClientProxyParams.Clear;
begin
  FProxyBypass := '';
  FproxyServer := '';
  FProxyUserName := '';
  FProxyPassword := '';
  FproxyPort := 0;
  DoChange(-1);
end;

{******************************************}
constructor TALHTTPClientProxyParams.Create;
Begin
  inherited create;
  FProxyBypass := '';
  FproxyServer := '';
  FProxyUserName := '';
  FProxyPassword := '';
  FproxyPort := 0;
  FOnchange := nil;
end;

{******************************************************************}
procedure TALHTTPClientProxyParams.DoChange(propertyIndex: Integer);
begin
  if assigned(FonChange) then FonChange(Self,propertyIndex);
end;

{*********************************************************************}
procedure TALHTTPClientProxyParams.SetProxyBypass(const Value: String);
begin
  If (Value <> FProxyBypass) then begin
    FProxyBypass := Value;
    DoChange(0);
  end;
end;

{***********************************************************************}
procedure TALHTTPClientProxyParams.SetProxyPassword(const Value: String);
begin
  If (Value <> FProxyPassword) then begin
    FProxyPassword := Value;
    DoChange(4);
  end;
end;

{********************************************************************}
procedure TALHTTPClientProxyParams.SetProxyPort(const Value: integer);
begin
  If (Value <> FProxyPort) then begin
    FProxyPort := Value;
    DoChange(2);
  end;
end;

{*********************************************************************}
procedure TALHTTPClientProxyParams.SetProxyServer(const Value: String);
begin
  If (Value <> FProxyServer) then begin
    FProxyServer := Value;
    DoChange(1);
  end;
end;

{***********************************************************************}
procedure TALHTTPClientProxyParams.SetProxyUserName(const Value: String);
begin
  If (Value <> FProxyUserName) then begin
    FProxyUserName := Value;
    DoChange(3);
  end;
end;

end.
